home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / runtime / major_gc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-07-03  |  8.5 KB  |  320 lines  |  [TEXT/R*ch]

  1. #include "config.h"
  2. #include "debugger.h"
  3. #include "fail.h"
  4. #include "freelist.h"
  5. #include "gc.h"
  6. #include "gc_ctrl.h"
  7. #include "globals.h"
  8. #include "major_gc.h"
  9. #include "misc.h"
  10. #include "mlvalues.h"
  11. #include "roots.h"
  12.  
  13. #ifdef macintosh
  14. #include <Memory.h>
  15. #endif
  16.  
  17. #include "runtime.h"
  18.  
  19. #ifdef ANSI
  20. #include <limits.h>
  21. #else
  22. #ifdef SIXTYFOUR
  23. #define LONG_MAX 0x7FFFFFFFFFFFFFFF
  24. #else
  25. #define LONG_MAX 0x7FFFFFFF
  26. #endif
  27. #endif
  28.  
  29. int percent_free;
  30. long major_heap_increment;
  31. char *heap_start, *heap_end;
  32. char *page_table;
  33. asize_t page_table_size;
  34. char *gc_sweep_hp;
  35. int gc_phase;
  36. static value *gray_vals;
  37. value *gray_vals_cur, *gray_vals_end;
  38. static asize_t gray_vals_size;
  39. static int heap_is_pure;   /* The heap is pure if the only gray objects
  40.                               below [markhp] are also in [gray_vals]. */
  41. unsigned long allocated_words;
  42. unsigned long extra_heap_memory;
  43. extern char *fl_merge;  /* Defined in freelist.c. */
  44.  
  45. static char *markhp, *chunk, *limit;
  46.  
  47. static void realloc_gray_vals ()
  48. {
  49.   value *new;
  50.  
  51.   Assert (gray_vals_cur == gray_vals_end);
  52.   if (gray_vals_size < stat_heap_size / 128){
  53.     gc_message ("Growing gray_vals to %ldk\n",
  54.         (long) gray_vals_size * sizeof (value) / 512);
  55.     new = (value *) realloc ((char *) gray_vals,
  56.                              2 * gray_vals_size * sizeof (value));
  57.     if (new == NULL){
  58.       gc_message ("No room for growing gray_vals\n", 0);
  59.       gray_vals_cur = gray_vals;
  60.       heap_is_pure = 0;
  61.     }else{
  62.       gray_vals = new;
  63.       gray_vals_cur = gray_vals + gray_vals_size;
  64.       gray_vals_size *= 2;
  65.       gray_vals_end = gray_vals + gray_vals_size;
  66.     }
  67.   }else{
  68.     gray_vals_cur = gray_vals + gray_vals_size / 2;
  69.     heap_is_pure = 0;
  70.   }
  71. }
  72.  
  73. void darken (v)
  74.      value v;
  75. {
  76.   if (Is_block (v) && Is_in_heap (v) && Is_white_val (v)){
  77.     Hd_val (v) = Grayhd_hd (Hd_val (v));
  78.     *gray_vals_cur++ = v;
  79.     if (gray_vals_cur >= gray_vals_end) realloc_gray_vals ();
  80.   }
  81. }
  82.  
  83. static void darken_root (p, v)
  84.      value *p;
  85.      value v;
  86. {
  87.   darken (v);
  88. }
  89.  
  90. static void start_cycle ()
  91. {
  92.   Assert (gray_vals_cur == gray_vals);
  93.   Assert (Is_white_val (global_data));
  94.   darken (global_data);
  95.   local_roots (darken_root);
  96.   gc_phase = Phase_mark;
  97.   markhp = NULL;
  98. }
  99.  
  100. static void mark_slice (work)
  101.      long work;
  102. {
  103.   value v, child;
  104.   mlsize_t i;
  105.  
  106.   while (work > 0){
  107.     if (gray_vals_cur > gray_vals){
  108.       v = *--gray_vals_cur;
  109.       Assert (Is_gray_val (v));
  110.       Hd_val (v) = Blackhd_hd (Hd_val (v));
  111.       if (Tag_val (v) < No_scan_tag){
  112.     for (i = Wosize_val (v); i > 0;){
  113.       --i;
  114.       child = Field (v, i);
  115.       darken (child);
  116.     }
  117.       }
  118.       work -= Whsize_val (v);
  119.     }else if (markhp != NULL){
  120.       if (markhp == limit){
  121.     chunk = (((heap_chunk_head *) chunk) [-1]).next;
  122.     if (chunk == NULL){
  123.       markhp = NULL;
  124.     }else{
  125.       markhp = chunk;
  126.       limit = chunk + (((heap_chunk_head *) chunk) [-1]).size;
  127.     }
  128.       }else{
  129.     if (Is_gray_val (Val_hp (markhp))){
  130.       Assert (gray_vals_cur == gray_vals);
  131.       *gray_vals_cur++ = Val_hp (markhp);
  132.     }
  133.     markhp += Bhsize_hp (markhp);
  134.       }
  135.     }else if (!heap_is_pure){
  136.       heap_is_pure = 1;
  137.       chunk = heap_start;
  138.       markhp = chunk;
  139.       limit = chunk + (((heap_chunk_head *) chunk) [-1]).size;
  140.     }else{
  141.       /* Marking is done. */
  142.       gc_sweep_hp = heap_start;
  143.       fl_init_merge ();
  144.       gc_phase = Phase_sweep;
  145.       chunk = heap_start;
  146.       gc_sweep_hp = chunk;
  147.       limit = chunk + (((heap_chunk_head *) chunk) [-1]).size;
  148.       work = 0;
  149.     }
  150.   }
  151. }
  152.  
  153. static void sweep_slice (work)
  154.      long work;
  155. {
  156.   char *hp;
  157.   header_t hd;
  158.  
  159.   while (work > 0){
  160.     if (gc_sweep_hp < limit){
  161.       hp = gc_sweep_hp;
  162.       hd = Hd_hp (hp);
  163.       work -= Whsize_hd (hd);
  164.       gc_sweep_hp += Bhsize_hd (hd);
  165.       switch (Color_hd (hd)){
  166.       case White:
  167.     if (Tag_hd (hd) == Final_tag){
  168.       Final_fun (Val_hp (hp)) (Val_hp (hp));
  169.     }
  170.     gc_sweep_hp = fl_merge_block (Bp_hp (hp));
  171.     break;
  172.       case Gray:
  173.     Assert (0);     /* Fall through to Black when not in debug mode. */
  174.       case Black:
  175.     Hd_hp (hp) = Whitehd_hd (hd);
  176.     break;
  177.       case Blue:
  178.     /* Only the blocks of the free-list are blue.  See [freelist.c]. */
  179.     fl_merge = Bp_hp (hp);
  180.     break;
  181.       }
  182.       Assert (gc_sweep_hp <= limit);
  183.     }else{
  184.       chunk = (((heap_chunk_head *) chunk) [-1]).next;
  185.       if (chunk == NULL){
  186.     /* Sweeping is done.  Start the next cycle. */
  187.         ++ stat_major_collections;
  188.     work = 0;
  189.     start_cycle ();
  190.       }else{
  191.     gc_sweep_hp = chunk;
  192.     limit = chunk + (((heap_chunk_head *) chunk) [-1]).size;
  193.       }
  194.     }
  195.   }
  196. }
  197.  
  198. void major_collection_slice ()
  199. {
  200.   /* Free memory at the start of the GC cycle:
  201.                  FM = stat_heap_size * percent_free / 100 * 2/3
  202.      Proportion of free memory consumed since the previous slice:
  203.                  PH = allocated_words / FM
  204.      Proportion of extra-heap memory consumed since the previous slice:
  205.                  PE = extra_heap_memory / stat_heap_size
  206.      Proportion of total work to do in this slice:
  207.                  P  = PH + PE
  208.      Amount of marking work for the GC cycle:
  209.                  MW = stat_heap_size * (100 - percent_free) / 100
  210.      Amount of sweeping work for the GC cycle:
  211.                  SW = stat_heap_size
  212.      Amount of marking work for this slice:
  213.                  MS = MW * 2 * P
  214.                  MS = 2 * (100 - percent_free)
  215.                       * (allocated_words * 3 / percent_free / 2
  216.                  + 100 * extra_heap_memory)
  217.      Amount of sweeping work for this slice:
  218.                  SS = SW * 2 * P
  219.                  SS = 2 * 100
  220.               * (allocated_words * 3 / percent_free / 2
  221.                  + 100 * extra_heap_memory)
  222.      This slice will either mark MS words or sweep SS words.
  223.   */
  224.  
  225. #define Margin 100  /* Make it a little faster to be on the safe side. */
  226.  
  227.   if (gc_phase == Phase_mark){
  228.     mark_slice (2 * (100 - percent_free)
  229.         * (allocated_words * 3 / percent_free / 2
  230.                    + 100 * extra_heap_memory)
  231.         + Margin);
  232.     gc_message ("!", 0);
  233.   }else{
  234.     Assert (gc_phase == Phase_sweep);
  235.     sweep_slice (200 * (allocated_words * 3 / percent_free / 2
  236.             + 100 * extra_heap_memory)
  237.          + Margin);
  238.     gc_message ("$", 0);
  239.   }
  240.   stat_major_words += allocated_words;
  241.   allocated_words = 0;
  242.   extra_heap_memory = 0;
  243. }
  244.  
  245. /* The minor heap must be empty when this function is called. */
  246. void finish_major_cycle ()
  247. {
  248.  
  249.   beg_gc_time();
  250.  
  251.   if (gc_phase == Phase_mark) mark_slice (LONG_MAX);
  252.   Assert (gc_phase == Phase_sweep);
  253.   sweep_slice (LONG_MAX);
  254.   stat_major_words += allocated_words;
  255.   allocated_words = 0;
  256.  
  257.   end_gc_time();
  258.  
  259. }
  260.  
  261. asize_t round_heap_chunk_size (request)
  262.      asize_t request;
  263. {                            Assert (major_heap_increment >= Heap_chunk_min);
  264.   if (request < major_heap_increment){
  265.                               Assert (major_heap_increment % Page_size == 0);
  266.     return major_heap_increment;
  267.   }else if (request <= Heap_chunk_max){
  268.     return ((request + Page_size - 1) >> Page_log) << Page_log;
  269.   }else{
  270.     raise_out_of_memory ();
  271.   }
  272. }
  273.  
  274. void init_major_heap (heap_size)
  275.      asize_t heap_size;
  276. {
  277.   asize_t i;
  278.  
  279.   stat_heap_size = round_heap_chunk_size (heap_size);
  280.   Assert (stat_heap_size % Page_size == 0);
  281.   heap_start = aligned_malloc (stat_heap_size + sizeof (heap_chunk_head),
  282.                    sizeof (heap_chunk_head));
  283.   if (heap_start == NULL)
  284.     fatal_error ("Fatal error: not enough memory for the initial heap.\n");
  285.   heap_start += sizeof (heap_chunk_head);
  286.   Assert ((unsigned long) heap_start % Page_size == 0);
  287.   (((heap_chunk_head *) heap_start) [-1]).size = stat_heap_size;
  288.   (((heap_chunk_head *) heap_start) [-1]).next = NULL;
  289.   heap_end = heap_start + stat_heap_size;
  290.   Assert ((unsigned long) heap_end % Page_size == 0);
  291. #ifdef SIXTEEN
  292.   page_table_size = 640L * 1024L / Page_size + 1;
  293. #else
  294.   page_table_size = 4 * stat_heap_size / Page_size;
  295. #endif
  296.   page_table = (char *) malloc (page_table_size);
  297.   if (page_table == NULL){
  298.     fatal_error ("Fatal error: not enough memory for the initial heap.\n");
  299.   }
  300.   for (i = 0; i < page_table_size; i++){
  301.     page_table [i] = Not_in_heap;
  302.   }
  303.   for (i = Page (heap_start); i < Page (heap_end); i++){
  304.     page_table [i] = In_heap;
  305.   }
  306.   Hd_hp (heap_start) = Make_header (Wosize_bhsize (stat_heap_size), 0, Blue);
  307.   fl_init_merge ();
  308.   fl_merge_block (Bp_hp (heap_start));
  309.   /* We start the major GC in the marking phase, just after the roots have been
  310.      darkened. (Since there are no roots, we don't have to darken anything.) */
  311.   gc_phase = Phase_mark;
  312.   gray_vals_size = 2048;
  313.   gray_vals = (value *) malloc (gray_vals_size * sizeof (value));
  314.   gray_vals_cur = gray_vals;
  315.   gray_vals_end = gray_vals + gray_vals_size;
  316.   heap_is_pure = 1;
  317.   allocated_words = 0;
  318.   extra_heap_memory = 0;
  319. }
  320.